home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
Queues
/
Queue
< prev
Wrap
Text File
|
1993-03-29
|
2KB
|
117 lines
unit Queue;
{This implements a double-ended queue with a fixed size limit.}
interface
type
Queue = record
Qhead, Qtail, Qsize: Integer;
Qelts: array[0..0] of Longint; {allow one empty element as a sentinel}
end;
QueuePtr = ^Queue;
QueueHandle = ^QueuePtr;
procedure NewQueue (itsSize: Integer;
var theQueue: QueueHandle);
procedure DisposeQueue (theQueue: QueueHandle);
procedure FlushQueue (theQueue: QueueHandle);
function QueueFull (theQueue: QueueHandle): Boolean;
function QueueEmpty (theQueue: QueueHandle): Boolean;
procedure EnqueueHead (item: univ Longint;
theQueue: QueueHandle);
procedure EnqueueTail (item: univ Longint;
theQueue: QueueHandle);
procedure DequeueHead (var item: univ Longint;
theQueue: QueueHandle);
implementation
procedure FlushQueue (theQueue: QueueHandle);
begin
with theQueue^^ do
begin
Qhead := 0;
Qtail := 0;
end;
end;
procedure NewQueue (itsSize: Integer;
var theQueue: QueueHandle);
begin
theQueue := QueueHandle(NewHandle(SIZEOF(Queue) + itsSize * SIZEOF(Longint))); {this leaves a sentinel}
theQueue^^.Qsize := itsSize;
FlushQueue(theQueue);
end;
procedure DisposeQueue (theQueue: QueueHandle);
begin
DisposHandle(Handle(theQueue));
end;
function QueueFull (theQueue: QueueHandle): Boolean;
begin
with theQueue^^ do
QueueFull := ((Qhead = Qsize) & (Qtail = 0)) | ((Qhead + 1) = Qtail);
end;
function QueueEmpty (theQueue: QueueHandle): Boolean;
begin
with theQueue^^ do
QueueEmpty := Qhead = Qtail;
end;
procedure EnqueueHead (item: univ Longint;
theQueue: QueueHandle);
begin
with theQueue^^ do
if not QueueFull(theQueue) then
begin
{$PUSH}
{$R-}
Qelts[Qhead] := item;
{$POP}
if Qhead = Qsize then
Qhead := 0
else
Qhead := Qhead + 1;
end;
end;
procedure EnqueueTail (item: univ Longint;
theQueue: QueueHandle);
begin
with theQueue^^ do
if not QueueFull(theQueue) then
begin
if Qtail = 0 then
Qtail := Qsize
else
Qtail := Qtail - 1;
{$PUSH}
{$R-}
Qelts[Qtail] := item;
{$POP}
end;
end;
procedure DequeueHead (var item: univ Longint;
theQueue: QueueHandle);
begin
with theQueue^^ do
if not QueueEmpty(theQueue) then
begin
if Qhead = 0 then
Qhead := Qsize
else
Qhead := Qhead - 1;
{$PUSH}
{$R-}
item := Qelts[Qhead];
{$POP}
end;
end;
end.